(ns pointer.core
  "Functions to help in finding the lines you care about."
  (:require [clojure.string :as string]
            [clojure.set :refer [superset?]]
            [clojure.zip :as zip]))

(declare -node?
         basename
         current-file-name
         replace-loc-line
         skip-to-rightmost-leaf)

(def ^:private fallback-line-number (atom (Integer. 0)))

;; COMPILE-TIME POSITIONS.
;; For annotating forms with information retrieved at runtime.
;; For reporting syntax errors

(declare line-number-for)

(defn compile-time-fallback-position []
  (list (current-file-name) @fallback-line-number))

(defn- this-filename []
  (.getFileName ^StackTraceElement (second (.getStackTrace (Throwable.)))))

(defn current-file-name []
  ;; clojure.test sometimes runs with *file* bound to #"NO_SOURCE.*".
  ;; This corrects that by looking up the stack. Note that it
  ;; produces a reasonable result for the repl, because the stack
  ;; frame it finds has NO_SOURCE_FILE as its "filename".
  (if-not (or (nil? *file*)
              (re-find #"NO_SOURCE" *file*))
    (basename *file*)
    (this-filename)))

(defn form-position [form]
  (list (current-file-name) (:line (meta form))))

(defn line-number-for [form]
  "Return the best guess for what line given form is on."
  ;; A 'lineish' is either a line number or nil.
  (let [lineish #(-> % zip/node meta :line)
        left-lineish #(-> % zip/left lineish)
        right-lineish #(-> % zip/right lineish)
        previous-lineish #(some-> % zip/prev zip/left lineish)
        ;; Note that the preceding function only works when the form before the arrow has no :line

        best-lineish (some-fn left-lineish
                              right-lineish
                              #(some-> % (previous-lineish) (inc)))
        loc (if (-node? form)
              form
              (zip/seq-zip form))]
    (if-let [lineish (best-lineish loc)]
      (reset! fallback-line-number lineish)
      (swap! fallback-line-number inc))))

(defn set-fallback-line-number-from [form]
  (reset! fallback-line-number (or (:line (meta form)) (Integer. 0))))

;; RUNTIME POSITIONS
;; These are positions that determine the file or line at runtime.

(defn form-with-copied-line-numbers [line-number-source form]
  (loop [loc (zip/seq-zip form)
         line-loc (zip/seq-zip line-number-source)]
    (cond (zip/end? line-loc)
          (zip/root loc)

          (zip/branch? line-loc)
          (recur (zip/next (replace-loc-line loc line-loc))
                 (zip/next line-loc))

          ;; the form has a tree in place of a non-tree
          (zip/branch? loc)
          (recur (zip/next
                  (skip-to-rightmost-leaf (zip/down (replace-loc-line loc line-loc))))
                 (zip/next line-loc))

          :else
          (recur (zip/next loc)
                 (zip/next line-loc)))))

(defmacro line-number-known
  "Guess the filename of a file position, but use the given line number."
  [number]
  `[(current-file-name) ~number])

(defn positioned-form
  "Make sure the form is annotated with a line number, either
   its original or the given one. Takes either a number or form
   as a source."
  [form number-source]
  (cond (contains? (meta form) :line)
        form

        (integer? number-source)
        (vary-meta form assoc :line number-source)

        ;; If the line number source was generated by a macro, it won't have metadata.
        (not (contains? (meta number-source) :line))
        (vary-meta form assoc :line (Integer. 0))

        :else
        (vary-meta form assoc :line (:line (meta number-source)))))

;; PRIVATE MEMBERS

(defn -node? [form]
  (-> form
      (meta)
      (keys)
      (set)
      (superset? #{:zip/make-node :zip/children :zip/branch?})))

(defn- basename [string]
  (last (string/split string #"/")))

(defn- replace-loc-line [loc loc-with-line]
  (let [m (fn [loc] (meta (zip/node loc)))
        transferred-meta (if (contains? (m loc-with-line) :line )
                           (assoc (m loc) :line (:line (m loc-with-line)))
                           (dissoc (m loc) :line ))]
    (zip/replace loc (with-meta (zip/node loc) transferred-meta))))

(defn- skip-to-rightmost-leaf
  "When positioned at leftmost position of branch, move to the end form.
   In a tree, that's the rightmost leaf."
  [loc]
  (let [end-form (zip/rightmost loc)]
    (if (zip/branch? end-form)
      (recur (zip/down end-form))
      end-form)))
